home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / OOPTUT34.ZIP / OOPTUTOR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-24  |  17KB  |  593 lines
  1. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  2. {                                                                    }
  3. {   Tutor for Turbo Pascal Object-oriented Programming (version 6.0) }
  4. {   Based on the Borland Turbo Vision program TVDEMO.PAS found on    }
  5. {   the Install diskette.                                            }
  6. {                                                                    }
  7. {   Program using Turbo Vision to provide a menu screen for the      }
  8. {   selection of Turbo Pascal OOP notes and example programs.        }
  9. {                                                                    }
  10. {   OOPTUTOR.PAS  -> .EXE      R Shaw    Copyright   9.11.92         }
  11. {____________________________________________________________________}
  12.  
  13. program OOPTutor;
  14.  
  15. {$X+,S-}
  16. {$M 16384,8192,655360}
  17.  
  18. { This program uses many of the Turbo Vision standard and demo units,
  19.   including:
  20.  
  21.     StdDlg    - Open file browser, change directory tree.
  22.     MsgBox    - Simple dialog to display messages.
  23.     ColorSel  - Color customization.
  24.     Gadgets   - Shows system time and available heap space.
  25.     FViewer   - Scroll through text files.
  26.     HelpFile  - Context sensitive help.
  27.     MouseDlg  - Mouse options dialog.
  28.  
  29.   And of course this program includes many standard Turbo Vision
  30.   objects and behaviors (menubar, desktop, status line, dialog boxes,
  31.   mouse support, window resize/move/tile/cascade).
  32. }
  33.  
  34. uses
  35.   Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
  36.   DemoCmds, Gadgets, FViewer, HelpFile, OOPHelp, ColorSel, MouseDlg, Hexa,
  37.   Crt;
  38.  
  39. const
  40.   cmRecInit      = 110;   { These are demonstration programs by R Shaw    }
  41.   cmObjInit      = 111;   { for the Turbo Pascal OOP course.              }
  42.   cmWrongOop     = 112;
  43.   cmRightOop     = 113;
  44.   cmJuniorOb     = 114;
  45.   cmFigDemo      = 116;
  46.   cmListDemo     = 117;
  47.   cmStreams      = 118;
  48.   cmProgOpen     = 119;
  49.   cmLOpen        = 120;
  50.   cmCollect      = 121;
  51.   cmObCompat     = 122;
  52.  
  53. type
  54.  
  55.   { TTVDemo }
  56.  
  57.   PTVDemo = ^TTVDemo;
  58.   TTVDemo = object(TApplication)
  59.     Clock: PClockView;
  60.     Heap: PHeapView;
  61.     constructor Init;
  62.     procedure FileOpen(WildCard: PathStr);
  63.     procedure GetEvent(var Event: TEvent); virtual;
  64.     function GetPalette: PPalette; virtual;
  65.     procedure HandleEvent(var Event: TEvent); virtual;
  66.     procedure Idle; virtual;
  67.     procedure InitMenuBar; virtual;
  68.     procedure InitStatusLine; virtual;
  69.     procedure LoadDesktop(var S: TStream);
  70.     procedure OutOfMemory; virtual;
  71.     procedure StoreDesktop(var S: TStream);
  72.     procedure ViewFile(FileName: PathStr);
  73.   end;
  74.  
  75. { CalcHelpName }
  76.  
  77. function CalcHelpName: PathStr;
  78. var
  79.   EXEName: PathStr;
  80.   Dir: DirStr;
  81.   Name: NameStr;
  82.   Ext: ExtStr;
  83. begin
  84.   if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  85.   else EXEName := FSearch('OOPTUTOR.EXE', GetEnv('PATH'));
  86.   FSplit(EXEName, Dir, Name, Ext);
  87.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  88.   CalcHelpName := FSearch('OOPHELP.HLP', Dir);
  89. end;
  90.  
  91.  
  92. { TTVDemo }
  93. constructor TTVDemo.Init;
  94. var
  95.   R: TRect;
  96.   I: Integer;
  97.   FileName: PathStr;
  98. begin
  99.   TApplication.Init;
  100.   RegisterObjects;
  101.   RegisterViews;
  102.   RegisterMenus;
  103.   RegisterDialogs;
  104.   RegisterApp;
  105.   RegisterHelpFile;
  106.   RegisterFViewer;
  107.  
  108.   GetExtent(R);
  109.   R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  110.   Clock := New(PClockView, Init(R));
  111.   Insert(Clock);
  112.  
  113.   GetExtent(R);
  114.   Dec(R.B.X);
  115.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  116.   Heap := New(PHeapView, Init(R));
  117.   Insert(Heap);
  118.  
  119.   for I := 1 to ParamCount do
  120.   begin
  121.     FileName := ParamStr(I);
  122.     if FileName[Length(FileName)] = '\' then
  123.       FileName := FileName + '*.*';
  124.     if (Pos('?', FileName) = 0) and (Pos('*', FileName) = 0) then
  125.       ViewFile(FExpand(FileName))
  126.     else FileOpen(FileName);
  127.   end;
  128. end;
  129.  
  130. procedure TTVDemo.FileOpen(WildCard: PathStr);
  131. var
  132.   D: PFileDialog;
  133.   FileName: PathStr;
  134. begin
  135.   D := New(PFileDialog, Init(WildCard, 'Open a File',
  136.     '~N~ame', fdOpenButton + fdHelpButton, 100));
  137.   D^.HelpCtx := hcFOFileOpenDBox;
  138.   if ValidView(D) <> nil then
  139.   begin
  140.     if Desktop^.ExecView(D) <> cmCancel then
  141.     begin
  142.       D^.GetFileName(FileName);
  143.       ViewFile(FileName);
  144.     end;
  145.     Dispose(D, Done);
  146.   end;
  147. end;
  148.  
  149. procedure TTVDemo.GetEvent(var Event: TEvent);
  150. var
  151.   W: PWindow;
  152.   HFile: PHelpFile;
  153.   HelpStrm: PDosStream;
  154. const
  155.   HelpInUse: Boolean = False;
  156. begin
  157.   TApplication.GetEvent(Event);
  158.   case Event.What of
  159.     evCommand:
  160.       if (Event.Command = cmHelp) and not HelpInUse then
  161.       begin
  162.         HelpInUse := True;
  163.         HelpStrm := New(PDosStream, Init(CalcHelpName, stOpenRead));
  164.         HFile := New(PHelpFile, Init(HelpStrm));
  165.         if HelpStrm^.Status <> stOk then
  166.         begin
  167.           MessageBox('Could not open help file.', nil, mfError + mfOkButton);
  168.           Dispose(HFile, Done);
  169.         end
  170.         else
  171.         begin
  172.           W := New(PHelpWindow,Init(HFile, GetHelpCtx));
  173.           if ValidView(W) <> nil then
  174.           begin
  175.             ExecView(W);
  176.             Dispose(W, Done);
  177.           end;
  178.           ClearEvent(Event);
  179.         end;
  180.         HelpInUse := False;
  181.       end;
  182.     evMouseDown:
  183.       if Event.Buttons <> 1 then Event.What := evNothing;
  184.   end;
  185. end;
  186.  
  187. function TTVDemo.GetPalette: PPalette;
  188. const
  189.   CNewColor = CColor + CHelpColor;
  190.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
  191.   CNewMonochrome = CMonochrome + CHelpMonochrome;
  192.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  193.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  194. begin
  195.   GetPalette := @P[AppPalette];
  196. end;
  197.  
  198. procedure TTVDemo.HandleEvent(var Event: TEvent);
  199.  
  200. procedure ChangeDir;
  201. var
  202.   D: PChDirDialog;
  203. begin
  204.   D := New(PChDirDialog, Init(cdNormal + cdHelpButton, 101));
  205.   D^.HelpCtx := hcFCChDirDBox;
  206.   if ValidView(D) <> nil then
  207.   begin
  208.     DeskTop^.ExecView(D);
  209.     Dispose(D, Done);
  210.   end;
  211. end;
  212.  
  213. procedure Tile;
  214. var
  215.   R: TRect;
  216. begin
  217.   Desktop^.GetExtent(R);
  218.   Desktop^.Tile(R);
  219. end;
  220.  
  221. procedure Cascade;
  222. var
  223.   R: TRect;
  224. begin
  225.   Desktop^.GetExtent(R);
  226.   Desktop^.Cascade(R);
  227. end;
  228.  
  229.  
  230. procedure About;
  231. var
  232.   D: PDialog;
  233.   Control: PView;
  234.   R: TRect;
  235. begin
  236.   R.Assign(0, 0, 60, 11);
  237.   D := New(PDialog, Init(R, 'About'));
  238.   with D^ do
  239.   begin
  240.     Options := Options or ofCentered;
  241.  
  242.     R.Grow(-1, -1);
  243.     Dec(R.B.Y, 3);
  244.     Insert(New(PStaticText, Init(R,
  245.       #13 +
  246.       ^C'Turbo Pascal OOP Tutor and Examples'#13 +
  247.       #13 +
  248.       ^C'R Shaw  Copyright  9.11.92'#13 +
  249.       #13 +
  250.       ^C'Based on a Turbo Vision program by Borland')));
  251.  
  252.     R.Assign(25, 8, 35, 10);
  253.     Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  254.   end;
  255.   if ValidView(D) <> nil then
  256.   begin
  257.     Desktop^.ExecView(D);
  258.     Dispose(D, Done);
  259.   end;
  260. end;
  261.  
  262. procedure Colors;
  263. var
  264.   D: PColorDialog;
  265. begin
  266.   D := New(PColorDialog, Init('',
  267.     ColorGroup('Desktop',
  268.       ColorItem('Color',             32, nil),
  269.     ColorGroup('Menus',
  270.       ColorItem('Normal',            2,
  271.       ColorItem('Disabled',          3,
  272.       ColorItem('Shortcut',          4,
  273.       ColorItem('Selected',          5,
  274.       ColorItem('Selected disabled', 6,
  275.       ColorItem('Shortcut selected', 7, nil)))))),
  276.     ColorGroup('Dialogs/Calc',
  277.       ColorItem('Frame/background',  33,
  278.       ColorItem('Frame icons',       34,
  279.       ColorItem('Scroll bar page',   35,
  280.       ColorItem('Scroll bar icons',  36,
  281.       ColorItem('Static text',       37,
  282.  
  283.       ColorItem('Label normal',      38,
  284.       ColorItem('Label selected',    39,
  285.       ColorItem('Label shortcut',    40,
  286.  
  287.       ColorItem('Button normal',     41,
  288.       ColorItem('Button default',    42,
  289.       ColorItem('Button selected',   43,
  290.       ColorItem('Button disabled',   44,
  291.       ColorItem('Button shortcut',   45,
  292.       ColorItem('Button shadow',     46,
  293.  
  294.       ColorItem('Cluster normal',    47,
  295.       ColorItem('Cluster selected',  48,
  296.       ColorItem('Cluster shortcut',  49,
  297.  
  298.       ColorItem('Input normal',      50,
  299.       ColorItem('Input selected',    51,
  300.       ColorItem('Input arrow',       52,
  301.  
  302.       ColorItem('History button',    53,
  303.       ColorItem('History sides',     54,
  304.       ColorItem('History bar page',  55,
  305.       ColorItem('History bar icons', 56,
  306.  
  307.       ColorItem('List normal',       57,
  308.       ColorItem('List focused',      58,
  309.       ColorItem('List selected',     59,
  310.       ColorItem('List divider',      60,
  311.  
  312.       ColorItem('Information pane',  61, nil))))))))))))))))))))))))))))),
  313.     ColorGroup('Viewer',
  314.       ColorItem('Frame passive',      8,
  315.       ColorItem('Frame active',       9,
  316.       ColorItem('Frame icons',       10,
  317.       ColorItem('Scroll bar page',   11,
  318.       ColorItem('Scroll bar icons',  12,
  319.       ColorItem('Text',              13, nil)))))), nil))))));
  320.  
  321.   D^.HelpCtx := hcOCColorsDBox;
  322.   if ValidView(D) <> nil then
  323.   begin
  324.     D^.SetData(Application^.GetPalette^);
  325.     if Desktop^.ExecView(D) <> cmCancel then
  326.     begin
  327.       Application^.GetPalette^ := D^.Pal;
  328.       DoneMemory;  { Dispose all group buffers }
  329.       ReDraw;      { Redraw application with new palette }
  330.     end;
  331.     Dispose(D, Done);
  332.   end;
  333. end;
  334.  
  335. procedure Mouse;
  336. var
  337.   D: PDialog;
  338. begin
  339.   D := New(PMouseDialog, Init);
  340.   D^.HelpCtx := hcOMMouseDBox;
  341.   if ValidView(D) <> nil then
  342.   begin
  343.     D^.SetData(MouseReverse);
  344.     if Desktop^.ExecView(D) <> cmCancel then
  345.       D^.GetData(MouseReverse);
  346.   end;
  347. end;
  348.  
  349. procedure DosShell(fname:string);
  350. begin
  351.   DoneSysError;
  352.   DoneEvents;
  353.   DoneVideo;
  354.   DoneMemory;
  355.   SetMemTop(HeapPtr);
  356.   SwapVectors;
  357.   If fname = 'D'
  358.     then
  359.       begin
  360.         PrintStr('Type EXIT to return...');
  361.         Exec(GetEnv('COMSPEC'), '');
  362.       end
  363.     else Exec(fname, '');
  364.   SwapVectors;
  365.   SetMemTop(HeapEnd);
  366.   InitMemory;
  367.   InitVideo;
  368.   InitEvents;
  369.   InitSysError;
  370.   Redraw;
  371. end;
  372.  
  373. procedure RetrieveDesktop;
  374. var
  375.   S: PStream;
  376. begin
  377.   S := New(PBufStream, Init('OOPTUTOR.DSK', stOpenRead, 1024));
  378.   if LowMemory then OutOfMemory
  379.   else if S^.Status <> stOk then
  380.     MessageBox('Could not open desktop file', nil, mfOkButton + mfError)
  381.   else
  382.   begin
  383.     LoadDesktop(S^);
  384.     if S^.Status <> stOk then
  385.       MessageBox('Error reading desktop file', nil, mfOkButton + mfError);
  386.   end;
  387.   Dispose(S, Done);
  388. end;
  389.  
  390. procedure SaveDesktop;
  391. var
  392.   S: PStream;
  393.   F: File;
  394. begin
  395.   S := New(PBufStream, Init('OOPTUTOR.DSK', stCreate, 1024));
  396.   if not LowMemory and (S^.Status = stOk) then
  397.   begin
  398.     StoreDesktop(S^);
  399.     if S^.Status <> stOk then
  400.     begin
  401.       MessageBox('Could not create OOPTUTOR.DSK.', nil, mfOkButton + mfError);
  402.       {$I-}
  403.       Dispose(S, Done);
  404.       Assign(F, 'OOPTUTOR.DSK');
  405.       Erase(F);
  406.       Exit;
  407.     end;
  408.   end;
  409.   Dispose(S, Done);
  410. end;
  411.  
  412.  
  413. begin
  414.   TApplication.HandleEvent(Event);
  415.   case Event.What of
  416.     evCommand:
  417.       begin
  418.         case Event.Command of
  419.           cmFOpen: FileOpen('*.txt');
  420.           cmLOpen: FileOpen('List.txt');
  421.           cmProgOpen: FileOpen('*.pas');
  422.           cmChDir: ChangeDir;
  423.           cmCascade: Cascade;
  424.           cmTile: Tile;
  425.           cmAbout: About;
  426.           cmRecInit: DosShell('\tp\ooptutor\recinit.exe');
  427.           cmObjInit: DosShell('\tp\ooptutor\objinit.exe');
  428.           cmWrongOop: DosShell('\tp\ooptutor\wrongoop.exe');
  429.           cmRightOop: DosShell('\tp\ooptutor\rightoop.exe');
  430.           cmJuniorOb: DosShell('\tp\ooptutor\juniorob.exe');
  431.           cmFigDemo: DosShell('\tp\ooptutor\figdemo.exe');
  432.           cmListDemo: DosShell('\tp\ooptutor\listdemo.exe');
  433.           cmStreams: DosShell('\tp\ooptutor\streams.exe');
  434.           cmCollect: DosShell('\tp\ooptutor\collect.exe');
  435.           cmObCompat: DosShell('\tp\ooptutor\obcompat.exe');
  436.           cmDosShell: DosShell('D');
  437.           cmColors: Colors;
  438.           cmMouse: Mouse;
  439.           cmSaveDesktop: SaveDesktop;
  440.           cmRetrieveDesktop: RetrieveDesktop;
  441.         else
  442.           Exit;
  443.         end;
  444.         ClearEvent(Event);
  445.       end;
  446.   end;
  447. end;
  448.  
  449. procedure TTVDemo.Idle;
  450.  
  451. function IsTileable(P: PView): Boolean; far;
  452. begin
  453.   IsTileable := P^.Options and ofTileable <> 0;
  454. end;
  455.  
  456. begin
  457.   TApplication.Idle;
  458.   Clock^.Update;
  459.   Heap^.Update;
  460.   if Desktop^.FirstThat(@IsTileable) <> nil then
  461.     EnableCommands([cmTile, cmCascade])
  462.   else
  463.     DisableCommands([cmTile, cmCascade]);
  464. end;
  465.  
  466. procedure TTVDemo.InitMenuBar;
  467. var
  468.   R: TRect;
  469. begin
  470.   GetExtent(R);
  471.   R.B.Y := R.A.Y+1;
  472.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  473.     NewSubMenu('~'#240'~', hcSystem, NewMenu(
  474.       NewItem('~A~bout', '', kbNoKey, cmAbout, hcSAbout, nil)),
  475.     NewSubMenu('~N~otes', hcNotes, NewMenu(
  476.       NewItem('~L~ist', '', kbNoKey, cmLOpen, hcList,
  477.       NewLine(
  478.       NewItem('~O~pen', 'F3', kbF3, cmFOpen, hcFOpen,
  479.       NewItem('~C~hange dir...', '', kbNoKey, cmChDir, hcFChangeDir,
  480.       NewLine(
  481.       NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcFDosShell,
  482.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcFExit, nil)))))))),
  483.     NewSubMenu('~E~xamples code',hcExCode, NewMenu(
  484.       NewItem('~O~pen', '', kbNoKey, cmProgOpen, hcPOpen,
  485.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcFExit, nil))),
  486.     NewSubMenu('~R~un examples',hcRunEx, NewMenu(
  487.       NewItem('~R~ecInit', '', kbNoKey, cmRecinit, hcRecinit,
  488.       NewItem('~O~bjInit', '', kbNoKey, cmObjinit, hcObjinit,
  489.       NewItem('~W~rongOOP', '', kbNoKey, cmWrongoop, hcWrongoop,
  490.       NewItem('R~i~ghtOOP', '', kbNoKey, cmRightoop, hcRightoop,
  491.       NewItem('~J~uniorOb', '', kbNoKey, cmJuniorob, hcJuniorob,
  492.       NewItem('~F~igDemo', '', kbNoKey, cmFigdemo, hcFigdemo,
  493.       NewItem('~L~istDemo', '', kbNoKey, cmListdemo, hcListdemo,
  494.       NewItem('~S~treams', '', kbNoKey, cmStreams, hcStreams,
  495.       NewItem('~C~ollect','', kbNoKey, cmCollect, hcCollect,
  496.       NewItem('O~b~Compat','', kbNoKey, cmObCompat, hcObCompat,
  497.        nil))))))))))),
  498.     NewSubMenu('~W~indows', hcWindows, NewMenu(
  499.       NewItem('~R~esize/move','Ctrl-F5', kbCtrlF5, cmResize, hcWSizeMove,
  500.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcWZoom,
  501.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcWNext,
  502.       NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcWClose,
  503.       NewItem('~T~ile', '', kbNoKey, cmTile, hcWTile,
  504.       NewItem('C~a~scade', '', kbNoKey, cmCascade, hcWCascade, nil))))))),
  505.     NewSubMenu('~O~ptions', hcOptions, NewMenu(
  506.       NewItem('~M~ouse...', '', kbNoKey, cmMouse, hcOMouse,
  507.       NewItem('~C~olors...', '', kbNoKey, cmColors, hcOColors,
  508.       NewLine(
  509.       NewItem('~S~ave desktop', '', kbNoKey, cmSaveDesktop, hcOSaveDesktop,
  510.       NewItem('~R~etrieve desktop', '', kbNoKey, cmRetrieveDesktop, hcORestoreDesktop, nil)))))),
  511.       nil)))))))));
  512. end;
  513.  
  514. procedure TTVDemo.InitStatusLine;
  515. var
  516.   R: TRect;
  517. begin
  518.   GetExtent(R);
  519.   R.A.Y := R.B.Y - 1;
  520.   StatusLine := New(PStatusLine, Init(R,
  521.     NewStatusDef(0, $FFFF,
  522.       NewStatusKey('~F1~ Help', kbF1, cmHelp,
  523.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  524.       NewStatusKey('~F3~ Open notes', kbF3, cmFOpen,
  525.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  526.       NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
  527.       NewStatusKey('~F10~ Menu', kbF10, cmMenu,
  528.       NewStatusKey('', kbCtrlF5, cmResize, nil))))))), nil)));
  529. end;
  530.  
  531. procedure TTVDemo.OutOfMemory;
  532. begin
  533.   MessageBox('Not enough memory available to complete operation.',
  534.     nil, mfError + mfOkButton);
  535. end;
  536.  
  537. { Since the safety pool is only large enough to guarantee that allocating
  538.   a window will not run out of memory, loading the entire desktop without
  539.   checking LowMemory could cause a heap error.  This means that each
  540.   window should be read individually, instead of using Desktop's Load.
  541. }
  542.  
  543. procedure TTVDemo.LoadDesktop(var S: TStream);
  544. var
  545.   P: PView;
  546.  
  547. procedure CloseView(P: PView); far;
  548. begin
  549.   Message(P, evCommand, cmClose, nil);
  550. end;
  551.  
  552. begin
  553.   if Desktop^.Valid(cmClose) then
  554.   begin
  555.     Desktop^.ForEach(@CloseView); { Clear the desktop }
  556.     repeat
  557.       P := PView(S.Get);
  558.       Desktop^.InsertBefore(ValidView(P), Desktop^.Last);
  559.     until P = nil;
  560.   end;
  561. end;
  562.  
  563. procedure TTVDemo.StoreDesktop(var S: TStream);
  564.  
  565. procedure WriteView(P: PView); far;
  566. begin
  567.   if P <> Desktop^.Last then S.Put(P);
  568. end;
  569.  
  570. begin
  571.   Desktop^.ForEach(@WriteView);
  572.   S.Put(nil);
  573. end;
  574.  
  575. procedure TTVDemo.ViewFile(FileName: PathStr);
  576. var
  577.   W: PWindow;
  578. begin
  579.   W := New(PFileWindow,Init(FileName));
  580.   W^.HelpCtx := hcViewer;
  581.   if ValidView(W) <> nil then
  582.     Desktop^.Insert(W);
  583. end;
  584.  
  585. var
  586.   Tutor: TTVDemo;
  587.  
  588. begin
  589.   Tutor.Init;
  590.   Tutor.Run;
  591.   Tutor.Done;
  592. end.
  593.